module Damas where

import Tablero
import Data.Char
import Data.Maybe

data Juego = J Color Tablero
data Movimiento = M Posicion Direccion
  deriving (Show, Eq)

data Arbol a = Nodo a [Arbol a] deriving Show
type ArbolJugadas = Arbol ([Movimiento], Juego)

type Valuacion = Juego -> Double

---- Funciones de regalo ----

instance Show Juego where
  show (J turno tablero) = "\n--Juegan las " ++ show turno ++ "s--\n" ++ show tablero

arbolDeJugadas :: Juego -> ArbolJugadas
arbolDeJugadas j = Nodo ([], j) $ zipWith agmov movs hijos
  where agmov m (Nodo (ms, r) hs) = Nodo ((m:ms), r) (map (agmov m) hs)
        movsJuegos = movimientosPosibles j
        movs = map fst movsJuegos
        hijos = map (arbolDeJugadas . snd) movsJuegos

---- Ejercicios ----

--AUX--------------------------------------
oponente::Color->Color
--Devuelve el color complementario
oponente color = if color==Blanca then Negra else Blanca

casillas::[(Char,Int)]
casillas = [(c,i)|c<-['a'..'h'],i<-[1..8]] --Lista de todas las posiciones validas

tablero :: Juego -> Tablero
tablero (J c t)  = t

tableroMovimientoIguales::(Movimiento,Tablero)->(Movimiento,Tablero)->Bool
tableroMovimientoIguales (m1,t1) (m2,t2) = (m1==m2) && (t1==t2)


--AUX--------------------------------------

-- Ejercicio 3
mover :: Movimiento -> Juego -> Maybe Juego
-- Si cumple con todas las condiciones, devuelve un juego en que que fue realizado el movimiento pedido, en caso contrario: Nothing
mover (M pos dir) (J color t)
	|   posValida pos && posValida posDest         --Que las casillas de origen y destino no caigan fuera del tablero.
	 && isJust (contenido pos t)                   --Que haya una ficha en la casilla de origen.
	 && deColor laFicha==color                     --Que el color de la ficha movida coincida con el color del jugador al que le toca mover.
	 && dirValida laFicha dir                      --Que la ficha se mueva en la dirección correcta, si no es una reina.
	 && isNothing (contenido posDest t)            --Que la casilla de destino esté libre.
	 && (not esCaptura || colorCaptura==adversario)--En caso de tratarse de una captura, que la casilla intermedia contenga una ficha del color del adversario.
	     = Just (J adversario hacerMovida)
	| otherwise = Nothing
		where nPos::Posicion -> Direccion -> Posicion
		      --Devuelve la posicion siguiente en funcion de la direccion de movimiento
		      nPos (c,i) d = case d of TL->(pred c,i+1); TR->(succ c,i+1); BL->(pred c,i-1); BR->(succ c,i-1)
		      
		      posValida::Posicion -> Bool --Una posicion es valida si esta adentro del tablero. 'a'<=c<='h', 1<=i<=8
		      posValida (c,i) = 1<=i&&i<=8 && elem c "abcdefgh"
		      
		      dirValida::Ficha -> Direccion -> Bool --Las direcciones en las que puede mover cada tipo de ficha
		      dirValida (Reina  _     ) _ = True
		      dirValida (Simple Blanca) d = elem d [TL,TR]
		      dirValida (Simple Negra ) d = elem d [BL,BR]
		      
		      deColor::Ficha -> Color --Obtener el color de una ficha
		      deColor (Simple clor) = clor
		      deColor (Reina  clor) = clor
		      
		      laFicha = fromJust (contenido pos t)  --La ficha a mover
		      esCaptura = isJust (contenido (nPos pos dir) t)  --El movimiento es una captura si hay una ficha en la direccion del movimiento
		      colorCaptura = deColor (fromJust (contenido (nPos pos dir) t))  --El color de la ficha a capturar
		      posDest = if esCaptura then nPos (nPos pos dir) dir else nPos pos dir  --La posicion destino del mov es la siguiente si no es una captura o la siguiente de la siguiente en caso de captura
		      adversario = oponente color --El color del adversario
		      hacerMovida = (poner laFichaNueva posDest (sacar pos (if esCaptura then sacar (nPos pos dir) t else t)))  --Crea un tablero nuevo igual que el original pero con el movimiento realizado
		      laFichaNueva = if esCoronacion then Reina color else laFicha  --Si es coronacion, la ficha nueva es una reina
		      esCoronacion = case color of Blanca->snd posDest==8; Negra->snd posDest==1  --Es coronacion si la pos destino es la linea inicial del oponente

-- Ejercicio 4
movimientosPosibles :: Juego -> [(Movimiento, Juego)]
movimientosPosibles j = [(mov,fromJust (mover mov j)) | mov<-movs, isJust (mover mov j)] --lista de movimientos y estado final para los movimientos validos (los que devuelven Just son validos)
	where movs=[M pos dir | pos<-casillas,dir<-[TL,TR,BL,BR]] --Combinacion de todos los movimientos posibles desde cada casilla

-- Ejercicio 5
foldArbol :: (a -> [b] -> b) -> Arbol a -> b
--Esquema de recursion sobre rosetree. Toma una funcion que procesa el valor de cada nodo junto con la lista de resultados de los nodo hijos
--aplica la funcion al valor del nodo y a la lista resultante de llamar recursivamente a la funcion sobre los hijos
foldArbol f (Nodo a ns)  = f a (map (foldArbol f) ns)

-- Ejercicio 6
podar :: Int -> Arbol a -> Arbol a
--Dado un entero n devuelve el arbol podado en el nivel n. usa el esquema de recursion de foldArbol
podar = flip (foldArbol (\a c n->Nodo a (if n==0 then [] else map ($ n-1) c)))
--Como la funcion toma mas de un parametro, cuando lo pasamos al esquema de foldArbol tenemos que pensar que estamos escribiendo una funcion que toma un arbol, y devuelve una funcion de arbol en entero.
--de esta forma el resultado de la recursion es una lista de funciones, que dado un entero, devuelven los subarboles podados.
--osea que la funcion que le pasamos al fold tiene 2 casos: si el entero es 0, devolvemos el mismo nodo pero sin hijos,
--sino, devolvemos un nodo que tiene como hijos a los subarboles resultantes de aplicar (n-1) a la recursion.
--(el resultado de la recursion es una lista de funciones Int->Arbol, osea que si les aplicamos (n-1) a cada una obtenemos una lista de subarboles podados en el nivel (n-1))

--La version recursiva seria asi:
--podar :: Arbol a -> Int -> Arbol a
--podar (Nodo a ns) 0 = Nodo a []
--podar (Nodo a ns) n = Nodo a (map (\x->podar x (n-1)) ns)

-- Ejercicio 7
mejorMovimiento :: Valuacion -> ArbolJugadas -> Movimiento
--El mejor movimiento es el proximo movimiento que hay que efectuar segun el resultado de minimax
mejorMovimiento v aj = head (snd (minimax v aj))

minimax :: Valuacion -> ArbolJugadas -> (Double, [Movimiento])
--Devuelve la secuencia de movimientos que se van a realizar si los 2 jugadores juegan a maximizar su valuacion
minimax val aj = foldArbol mm aj
	where mm::([Movimiento], Juego)->[(Double, [Movimiento])]->(Double, [Movimiento])
	      --si estoy en una hoja (o en una posicion ganadora) evaluo la valuacion del juego,
	      --sino, devuelvo el minimo con el signo negado. de esta forma cada jugador juega lo que mas le conviene a el y supone que el adversario juega de la misma forma.
	      mm (ms, j) bs = if null bs || abs (val j) == 1 then (val j, ms) else nega (minm bs)
	      
	      minm::[(Double, [Movimiento])]->(Double, [Movimiento])
	      --funcion que encuentra el minimo de una lista de tuplas
	      minm bs = foldr (\x y->if (fst x)<(fst y) then x else y) (head bs) bs
	      
	      nega::(Double, [Movimiento])->(Double, [Movimiento])
	      --negacion de la primera componente de la tupla
	      nega (d,ms) = (-d,ms)


-- Ejercicio 8
ganador :: Juego -> Maybe Color
--si adversario no tiene mas fichas, gano yo
--si no tengo movimientos posibles, gana adversario
ganador (J c t) | null (filter esFichaAdv (map queFicha casillas)) = Just c
                | null (movimientosPosibles (J c t)) = Just adv
                | otherwise = Nothing
	where adv = oponente c
	      esFichaAdv f = f==Just (Simple adv) || f==Just (Reina adv) --si la ficha es del adversario
	      queFicha pos = contenido pos t

-- Ejercicio 9
valuacionDamas :: Juego -> Double
--Si hay un ganador definido, la valuacion es +-1
--sino, es la formula magica
valuacionDamas (J c (T f)) | isJust (ganador (J c (T f))) = if ganador (J c (T f)) == Just c then 1.0 else -1.0
                           | otherwise = (fromIntegral (2*(2*r+s)))/(fromIntegral (2*rt+st)) - 1.0
	where cant ficha = length (filter (==Just ficha) (map f casillas)) --contador de fichas
	      r = cant (Reina c)
	      s = cant (Simple c)
	      rt= r + cant (Reina adv)
	      st= s + cant (Simple adv)
	      adv = oponente c
